home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
tex
/
webtp55.zip
/
ASM2INL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-12-05
|
55KB
|
1,878 lines
{$R-,S-,I-,F-,V-,B-,N-,A+}
Unit Asm2Inl;
{-Convert assembler instructions to inlines}
{ based on the inline assembler in Inline219 by L. David Baldwin
changed for use with TANGLE, 3.8.89 Peter Sawatzki
28 Vers 2.20 Fix sign extension bug, 4.8.89 PS
------------ 17-27: L. David Baldwin ---------
27 Vers 2.19 Fix CMP AX,-1, etc., incorrect in Vers 2.18.
26 Vers 2.18 Implement the sign extension bit for some instructions
25 Vers 2.17 Convert to Turbo 4.
24 Vers 2.16 Change byte size check in MemReg so the likes of
MOV [DI+$FE],AX will assemble right.
Allow ',' in DB pseudo op instruction.
23 Vers 2.15 Fix 'shl cl,1' which assembled as shl cl,cl
22 Vers 2.14 Change output format to better accomodate map file line numbers.
21 Vers 2.13 Allow JMP SHORT direct using symbols.
20 Vers 2.12 Allow CALL and JMP direct using symbols.
19 Vers 2.11
Fix bug in CallJmp and ShortJmp which didn't restrict short
jump range properly.
Fix bug which didn't allow CALL or JMP register. (CALL BX).
18 Vers 2.1
Fix bug in Accum which occasionally messed up IN and OUT instr.
Fix unintialized function in getnumber for quoted chars.
17 Vers 2.03
Change GetSymbol to accept about anything after '>' or '<'
Add 'NEW' pseudoinstruction.
Fix serious bug in defaultextension.
Add Wait_Already to prevent 2 'WAIT's from occuring.
Use 'tindex<maxbyte' comparison rather than <= which won't work
with integer comparison in this case.
}
Interface
Const
Maxbyte = 4000; {MaxInt}
InBufMax = 4000;
Var
TextArray : Array[0..Maxbyte] Of Char;
Procedure SetupAsm;
Function FeedAsm(Ch : Char) : Boolean;
Function DoAsm(InsertComments : Boolean) : Boolean;
Function ObjSize : Word;
Implementation
Const
Symbolleng = 32; {maximum of 32 char symbols}
CR = 13; Lf = 10; Tab = 9;
BigStringSize = 127;
Type
SymString = String[Symbolleng];
IndxReg = (BX, SI, DI, BP, None);
IndxSet = Set Of IndxReg;
PtrType = (BPtr, WPtr, DwPtr, QwPtr, TbPtr, UnkPtr); {keep order}
String4 = String[4];
String5 = Array[1..5] Of Char;
Symtype = (Address, Disp8, Disp16, Othersym, EOLsym, Identifier, JmpDist,
LfBrack, RtBrack, Plus, Comma, STsym);
BigString = String[BigStringSize]; {125 chars on a turbo line}
Label_Info_ptr = ^Label_Info;
Label_Info = Record
Name : SymString;
ByteCnt : Integer;
Next : Label_Info_ptr;
End;
Fixup_Info_Ptr = ^Fixup_Info;
Fixup_Info = Record
Name : SymString;
Indx, Indx2, Fix_pt : Integer;
Jmptype : (Short, Med);
Prev, Next : Fixup_Info_Ptr;
End;
Var
InBufEnd : 0..InBufMax;
InBuf : Array[0..InBufMax] Of Char;
StartChi : Word;
EofInstr : Boolean;
NoAddrs, Aerr, Symbol, TheEnd, NewFnd, St_first,
Displace, WordSize, Wait_Already : Boolean;
Addr : Integer;
Sym : Symtype;
Reg1, Reg2, W1, W2: byte;
ModeByte,Sti_val : Integer;
SaveOfs, DataVal : Record
Symb : Boolean;
Sname : SymString;
Value : Integer;
End;
IRset : IndxSet;
Rmm, Md : Integer;
ByWord : PtrType;
Byt, SignExt : Byte;
Tindex, Tindex0, Column, ByteCount, LastSlash : Integer;
TokStr : SymString;
UCh, LCh : Char;
Chi, OldChi : Integer;
Start_Col : Integer;
Firstlabel, Pl : Label_Info_ptr;
Firstfix, Pf : Fixup_Info_Ptr;
Function GetStr(p : Word) : String;
Var
s : String;
Begin
s := '';
Dec(p);
While (p < InBufEnd) And (InBuf[p] <> '/') Do Begin
Inc(Byte(s[0]));
s[Length(s)] := InBuf[p];
Inc(p);
End;
GetStr := s
End;
Procedure InsertStr(s : BigString); Forward;
Procedure Error(s : BigString);
Begin
If Not Aerr Then Begin
WriteLn;
WriteLn(GetStr(StartChi));
Write('':(Start_Col+(Chi-StartChi)),'^Error');
If Length(s) > 0 Then
Write(': ', s);
WriteLn;
Aerr := True;
InsertStr('{!Error: '+s+'}'); {-mark error in source file}
End;
End;
Procedure SetupAsm;
Begin
InBufEnd := 0;
End;
Function FeedAsm(Ch : Char) : Boolean;
Begin
If InBufEnd = InBufMax Then
FeedAsm := False
Else Begin
FeedAsm := True;
InBuf[InBufEnd] := Ch;
Inc(InBufEnd)
End
End;
{the following are definitions and variables for the parser}
Var
Segm, NValue : Integer;
Symname : SymString;
{end of parser defs}
Procedure GetCh;
{return next char in uch and lch with uch in upper case.}
Begin
If Chi < InBufEnd Then Begin
LCh := InBuf[Chi];
If LCh = '/' Then
LCh := Chr(CR);
UCh := Upcase(LCh);
Inc(Chi);
End Else Begin
LCh := Chr(CR);
UCh := Chr(CR);
TheEnd := True
End;
End;
Procedure SkipSpaces;
Begin
While (UCh = ' ') Or (UCh = Chr(Tab)) Do GetCh;
End;
Function GetDec(Var V : Integer) : Boolean;
Const
Ssize = 8;
Var
s: String[Ssize];
Getd: Boolean;
Code: Integer;
Begin
Getd := False;
s := '';
While (UCh >= '0') And (UCh <= '9') Do
Begin
Getd := True;
If Ord(s[0]) < Ssize Then s := s+UCh;
GetCh;
End;
If Getd Then
Begin
Val(s, V, Code);
If Code <> 0 Then Error('Bad number format');
End;
GetDec := Getd;
End;
Function GetHex(Var H : Integer) : Boolean;
Var
Digit: Integer; {check for '$' before the call}
Begin
H := 0; GetHex := False;
While (UCh In ['A'..'F', '0'..'9']) Do
Begin
GetHex := True;
If (UCh >= 'A') Then Digit := Ord(UCh)-Ord('A')+10
Else Digit := Ord(UCh)-Ord('0');
If H And $F000 <> 0 Then Error('Overflow');
H := (H Shl 4)+Digit;
GetCh;
End;
End;
Function GetNumber(Var N : Integer) : Boolean;
{get a number and return it in n}
Var Term : Char;
Err : Boolean;
Begin
N := 0;
If UCh = '(' Then GetCh; {ignore ( }
If (UCh = '''') Or (UCh = '"') Then
Begin
GetNumber := True;
Term := UCh; GetCh; Err := False;
While (UCh <> Term) And Not Err Do Begin
Err := N And $FF00 <> 0;
N := (N Shl 8)+Ord(LCh);
GetCh;
If Err Then Error('Overflow')
End;
GetCh; {use up termination char}
End
Else If UCh = '$' Then
Begin {a hex number}
GetCh;
If Not GetHex(N) Then Error('Hex number exp');
GetNumber := True;
End
Else
GetNumber := GetDec(N); {maybe a decimal number}
If UCh = ')' Then GetCh; {ignore an ending parenthesis}
End;
Function GetExpr(Var Rslt : Integer) : Boolean;
Var
Rs1, Rs2, SaveChi : Integer;
Pos, Neg : Boolean;
Begin
SaveChi := Chi;
GetExpr := False;
SkipSpaces;
Neg := UCh = '-';
Pos := UCh = '+';
If Pos Or Neg Then GetCh;
If GetNumber(Rs1) Then
Begin
GetExpr := True;
If Neg Then Rs1 := -Rs1;
If (UCh = '+') Or (UCh = '-') Then
If GetExpr(Rs2) Then
Inc(Rs1, Rs2); {getexpr will take care of sign}
Rslt := Rs1;
End
Else
Begin
Chi := SaveChi-1; GetCh;
End;
End;
{$v+}
Function GetSymbol(Var s : SymString) : Boolean;
Const
Symchars : Set Of Char = ['@'..'Z', '0'..'9', '_', '+', '-', '$', '*'];
Begin
If UCh In Symchars Then
Begin